home *** CD-ROM | disk | FTP | other *** search
/ Travel to Space / Travel to Space.iso / dos_prog / astrolgy / moonph / moonph.bas < prev    next >
BASIC Source File  |  1991-08-06  |  9KB  |  181 lines
  1. 100   '*************************************************************************
  2. 200   '*                        PHASES OF THE MOON                             *
  3. 300   '*                                                                       *
  4. 400   '*                   Programmer: Daniel P. Franco                        *
  5. 500   '*                                                                       *
  6. 600   '*                          VERSION 1.0.0                                *
  7. 700   '*                          March 8, 1987                                *
  8. 800   '*                           [73307,3471]                                *
  9. 900   '*                                                                       *
  10. 1000  '*  This program calculates the phase of the moon for a given year       *
  11. 1100  '*  and month. The user inputs the year, the month, and the number of    *
  12. 1200  '*  consecutive months data are required for. Output includes Ephemeris  *
  13. 1300  '*  Time of each phase beginning with the new moon.                      *
  14. 1400  '*                                                                       *
  15. 1500  '*************************************************************************
  16. 1600  '*************************************************************************
  17. 1700  '*                                                                       *
  18. 1800  '*                           INPUT SECTION                               *
  19. 1900  '*                                                                       *
  20. 2000  '*************************************************************************
  21. 2100 CLS
  22. 2200 DEFDBL A-Z
  23. 2300 PRINT "Enter Year:"
  24. 2400 INPUT YEAR
  25. 2500 LEAP=YEAR MOD 4 'if leap = 0 then year is a leap year
  26. 2600 PRINT "Enter Month:"
  27. 2700 INPUT MONTH
  28. 2800 PRINT "Output For How Many Months:"
  29. 2900 INPUT COUNT
  30. 3000 IF LEAP <> 0 THEN 3400 ELSE 4700
  31. 3100 '**************************************************************************
  32. 3200 '*                 CALCULATION FOR DECIMAL YEARS                          *
  33. 3300 '**************************************************************************
  34. 3400 IF MONTH = 1 THEN YD = .0424375935815675#
  35. 3500 IF MONTH = 2 THEN YD = .1232059168497121#
  36. 3600 IF MONTH = 3 THEN YD = .2039742401178567#
  37. 3700 IF MONTH = 4 THEN YD = .2874804726493282#
  38. 3800 IF MONTH = 5 THEN YD = .3709867051807998#
  39. 3900 IF MONTH = 6 THEN YD = .4544929377122713#
  40. 4000 IF MONTH = 7 THEN YD = .5379991702437429#
  41. 4100 IF MONTH = 8 THEN YD = .6228743574068778#
  42. 4200 IF MONTH = 9 THEN YD = .7063805899383494#
  43. 4300 IF MONTH = 10 THEN YD = .7898868224698209#
  44. 4400 IF MONTH = 11 THEN YD = .8733930550012924#
  45. 4500 IF MONTH = 12 THEN YD = .956899287532764#
  46. 4600 GOTO 6000
  47. 4700 IF LEAP = 0 GOTO 4800
  48. 4800 IF MONTH = 1 THEN YD = .0424375935815675#
  49. 4900 IF MONTH = 2 THEN YD = .1245748714813756#
  50. 5000 IF MONTH = 3 THEN YD = .2053431947495202#
  51. 5100 IF MONTH = 4 THEN YD = .2888494272809917#
  52. 5200 IF MONTH = 5 THEN YD = .3723556598124632#
  53. 5300 IF MONTH = 6 THEN YD = .4558618923439348#
  54. 5400 IF MONTH = 7 THEN YD = .5393681248754063#
  55. 5500 IF MONTH = 8 THEN YD = .6242433120385413#
  56. 5600 IF MONTH = 9 THEN YD = .7077495445700128#
  57. 5700 IF MONTH = 10 THEN YD = .7912557771014844#
  58. 5800 IF MONTH = 11 THEN YD = .8747620096329559#
  59. 5900 IF MONTH = 12 THEN YD = .9582682421644275#
  60. 6000 K = ((YEAR+YD) - 1900) * 12.3685
  61. 6100 K = CINT(K)
  62. 6200 COUNT = K + COUNT
  63. 6300 T = K/1236.85
  64. 6400 T2 = T ^ 2
  65. 6500 T3 = T ^ 3
  66. 6600 PI=3.141592653589793#
  67. 6700 R=PI/180
  68. 6800 '**************************************************************************
  69. 6900 '*                        SUN MEAN ANOMALY                                *
  70. 7000 '**************************************************************************
  71. 7100 SMA = 359.2242 + (29.10535608# * K)-(.0000333*T2)-(3.47E-06*T3)
  72. 7200 IF SMA > 360 THEN SMA=SMA/360:SMA=SMA-FIX(SMA):SMA=SMA*360
  73. 7300 '**************************************************************************
  74. 7400 '*                       MOON MEAN ANOMALY                                *
  75. 7500 '**************************************************************************
  76. 7600 MMA = 306.0253+(385.81691806#*K)+(.0107306*T2)+(1.236E-05*T3)
  77. 7700 IF MMA > 360 THEN MMA=MMA/360:MMA=MMA-FIX(MMA):MMA=MMA*360
  78. 7800 '**************************************************************************
  79. 7900 '*                 MOON'S ARGUMENT OF LATITUDE                            *
  80. 8000 '**************************************************************************
  81. 8100 F = 21.2964+(390.67050646#*K)-(.0016528*T2)-(2.39E-06*T3)
  82. 8200 IF F > 360 THEN F=F/360:F=F-FIX(F):F=F*360
  83. 8300 '**************************************************************************
  84. 8400 '*                   MEAN PHASE OF THE MOON                               *
  85. 8500 '**************************************************************************
  86. 8600 JD=2415020.75933#+(29.53058868#*K)+(.0001178*T2)-(1.55E-07*T3)+(.00033*SIN((R*166.56)+(R*132.87)*T)-((R*.009173*T2)))
  87. 8700 SMA=SMA*R
  88. 8800 MMA=MMA*R
  89. 8900 F=F*R
  90. 9000 '**************************************************************************
  91. 9100 '*        TRUE PHASE CORRECTIONS FOR NEW AND FULL MOON                    *
  92. 9200 '**************************************************************************
  93. 9300 IF K-FIX(K)=0 OR K-FIX(K) =.5 OR K-FIX(K)=-.5 THEN 9400 ELSE 11100
  94. 9400 JD=JD+((.1734-.000393*T)*SIN(SMA))
  95. 9500 JD=JD+(.0021*SIN(2*SMA))
  96. 9600 JD=JD-(.4068*SIN(MMA))
  97. 9700 JD=JD+(.0161*SIN(2*MMA))
  98. 9800 JD=JD-(.0004*SIN(3*MMA))
  99. 9900 JD=JD+(.0104*SIN(2*F))
  100. 10000 JD=JD-(.0051*SIN(SMA+MMA))
  101. 10100 JD=JD-(.0074*SIN(SMA-MMA))
  102. 10200 JD=JD+(.0004*SIN((2*F)+SMA))
  103. 10300 JD=JD-(.0004*SIN((2*F)-SMA))
  104. 10400 JD=JD-(6.000001E-04*SIN((2*F)+MMA))
  105. 10500 JD=JD+(.001*SIN((2*F)-MMA))
  106. 10600 JD=JD+.0005*SIN(SMA+(2*MMA))
  107. 10700 GOTO 14300
  108. 10800 '*************************************************************************
  109. 10900 '*        TRUE PHASE CORRECTIONS FOR FOR FIRST AND LAST QUARTER          *
  110. 11000 '*************************************************************************
  111. 11100 JD=JD+(.1721-.0004*T)*SIN(SMA)
  112. 11200 JD=JD+.0021*SIN(2*SMA)
  113. 11300 JD=JD-.628*SIN(MMA)
  114. 11400 JD=JD+.0089*SIN(2*MMA)
  115. 11500 JD=JD-.0004*SIN(3*MMA)
  116. 11600 JD=JD+.0079*SIN(2*F)
  117. 11700 JD=JD-.0119*SIN(SMA+MMA)
  118. 11800 JD=JD-.0047*SIN(SMA-MMA)
  119. 11900 JD=JD+.0003*SIN(2*F+SMA)
  120. 12000 JD=JD-.0004*SIN(2*F-SMA)
  121. 12100 JD=JD-6.000001E-04*SIN(2*F+MMA)
  122. 12200 JD=JD+.0021*SIN(2*F-MMA)
  123. 12300 JD=JD+.0003*SIN(SMA+2*MMA)
  124. 12400 JD=JD+.0004*SIN(SMA-2*MMA)
  125. 12500 JD=JD-.0003*SIN(2*SMA-MMA)
  126. 12600 '*************************************************************************
  127. 12700 '*             ADDITIONAL FIRST QUARTER CORRECTION                       *
  128. 12800 '*************************************************************************
  129. 12900 IF K => 0 AND K-FIX(K) = .25 THEN 13100 ELSE 13000
  130. 13000 IF K < 0 AND K-FIX(K)=-.75 THEN 13100 ELSE 13600
  131. 13100 JD=JD+.0028-.0004*COS(SMA)+.0003*COS(MMA)
  132. 13200 GOTO 14300
  133. 13300 '*************************************************************************
  134. 13400 '*             ADDITIONAL LAST QUARTER CORRECTION                        *
  135. 13500 '*************************************************************************
  136. 13600 IF K => 0 AND K-FIX(K) = .75 THEN 13800 ELSE 13700
  137. 13700 IF K < 0 AND K-FIX(K) =-.25 THEN 13800 ELSE 14300
  138. 13800 JD=JD-.0028+.0004*COS(SMA)-.0003*COS(MMA)
  139. 13900 GOTO 14300
  140. 14000 '*************************************************************************
  141. 14100 '*                CALENDAR DATE CALCULATION                              *
  142. 14200 '*************************************************************************
  143. 14300 JD=JD+.5
  144. 14400 Z=INT(JD)
  145. 14500 FRAC=JD-FIX(JD)
  146. 14600 IF Z < 2299161! THEN A=Z
  147. 14700 IF Z => 2299161! THEN ALPHA=INT((Z-1867216.25#)/36524.25)
  148. 14800 IF Z => 2299161! THEN A=Z+1+ALPHA-INT(ALPHA/4)
  149. 14900 B=A+1524
  150. 15000 C=INT((B-122.1)/365.25)
  151. 15100 D=INT(365.25*C)
  152. 15200 E=INT((B-D)/30.6001)
  153. 15300 DOM=B-D-INT(30.6001*E)+FRAC
  154. 15400 IF E<13.5 THEN M=E-1
  155. 15500 IF E>13.5 THEN M=E-13
  156. 15600 IF M>2.5 THEN Y=C-4716
  157. 15700 IF M<2.5 THEN Y=C-4715
  158. 15800 DAYINT=INT(DOM)
  159. 15900 DAYFRAC=DOM-FIX(DOM)
  160. 16000 TOTSEC=DAYFRAC*86400!
  161. 16100 TOTHOURS=(TOTSEC/60)/60
  162. 16200 HOUR =INT(TOTHOURS)
  163. 16300 MINLEFT=TOTHOURS-FIX(TOTHOURS)
  164. 16400 TOTMIN=(MINLEFT*60)
  165. 16500 MIN=INT(TOTMIN)
  166. 16600 SECLEFT=TOTMIN-FIX(TOTMIN)
  167. 16700 SEC=(SECLEFT*60)
  168. 16800 IF K => 0 AND K-FIX(K)=0 THEN PHASE$="NEW MOON"
  169. 16900 IF K=> 0 AND K-FIX(K)=.25 THEN PHASE$="FIRST QUARTER"
  170. 17000 IF K=> 0 AND K-FIX(K)=.5 THEN PHASE$="FULL MOON"
  171. 17100 IF K=> 0 AND K-FIX(K)=.75 THEN PHASE$="LAST QUARTER"
  172. 17200 IF K < 0 AND K-FIX(K) = 0 THEN PHASE$="NEW MOON"
  173. 17300 IF K < 0 AND K-FIX(K) = -.75 THEN PHASE$="FIRST QUARTER"
  174. 17400 IF K < 0 AND K-FIX(K) = -.5 THEN PHASE$="FULL MOON"
  175. 17500 IF K < 0 AND K-FIX(K) = -.25 THEN PHASE$="LAST QUARTER"
  176. 17600 PRINT USING "####  ##  ##     ## \   \  ## \  \  ##.## \  \     \              \";Y,M,DAYINT,HOUR,"Hours",MIN,"Min.",SEC,"Sec.",PHASE$
  177. 17700 K=K+.25
  178. 17800 IF K = COUNT GOTO 18000
  179. 17900 GOTO 6300
  180. 18000 END
  181.